Magnum One

home *** CD-ROM | disk | FTP | other *** search

/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d27 / backup.arc / BKP100.RPG < prev next >

Wrap

Text File | 1991-12-04 | 36.5 KB | 457 lines

~ H* * CRTRPGPGM PGM(BKP100.YOURLIB) SRCFILE(YOUSRC.YOURLIB) + ~ H* USRPRF(*USER) PUBAUT(*NORMAL) * ~ H* ~ H* *********************************************************** ~ H* * PROGRAM: BKP100.YOURLIB * ~ H* * DISCRIPTION: BACKUP FILE MAINTENANCE * ~ H* * * ~ H* * * ~ H* * COMPILATION OPTIONS: CREATE DSPOBJD OUTFILE FIRST. * ~ H* * SWITCHES: NONE * ~ H* * * ~ H* * WRITEN BY BRIAN GREWAL. * ~ H* * * ~ H* * DITO DITTO DITTTO * ~ H* * * ~ H* * * ~ H* * * ~ H* * * ~ H* *********************************************************** ~ H* FBACKUPF UF E K DISK A FDSPOBJD IF E DISK UC FBKP100FMCF E WORKSTN F LRRN KSFILE LIBSFL F ORRN KSFILE OBJSFL E OPT 6 1 OPTION FOR LIBS E OOPT 6 1 OPTION FOR OBJS E LIB 6 10 LIBRARY NAMES E OBJ 6 10 OBJECT NAMES E CMD 80 80 1 DSPOBJD COMMAND E OVR 50 50 1 OVRDBF COMMAND ILIBSFL I OPT1 OPT,1 I OPT2 OPT,2 I OPT3 OPT,3 I OPT4 OPT,4 I OPT5 OPT,5 I OPT6 OPT,6 I LIB1 LIB,1 I LIB2 LIB,2 I LIB3 LIB,3 I LIB4 LIB,4 I LIB5 LIB,5 I LIB6 LIB,6 IOBJSFL I OOPT1 OOPT,1 I OOPT2 OOPT,2 I OOPT3 OOPT,3 I OOPT4 OOPT,4 I OOPT5 OOPT,5 I OOPT6 OOPT,6 I OBJ1 OBJ,1 I OBJ2 OBJ,2 I OBJ3 OBJ,3 I OBJ4 OBJ,4 I OBJ5 OBJ,5 I OBJ6 OBJ,6 ~ C* DEFINE KEY ~ C* C KEY KLIST ~ C KFLD WBKPTP ~ C KFLD SAVCOD ~ C KFLD LIBNAM ~ C KFLD OBJNAM ~ ~ C** ~ C* SET ON/OFF SWITCHES FOR INDICATORS C MOVE '1' ON 1 ~ C MOVE '0' OFF 1 ~ C *IN99 DOWEQOFF ~ C FMENU TAG ~ C EXFMTMENU ~ C *IN99 CABEQON EXIT ~CMD 1 PRESSED C OPTION CABEQ0 FMENU 90~INVALID OPTION ~ C* RESET INDICATORS C SETOF 717273~ C SETOF 7490 ~ ~ C* INITIALIZE FIELDS C MOVE *BLANKS LIBNAM ~ C MOVE *BLANKS OBJNAM ~ C MOVE ' ' SAVCOD ~ ~ C* DAILY BACKUP C OPTION IFEQ 1 ~ C MOVE 'D' WBKPTP 1 ~ C SETON 71 ~ C ELSE ~ ~ C* WEEKLY BACKUP C OPTION IFEQ 2 ~ C MOVE 'W' WBKPTP ~ C SETON 72 ~ ~ C* MONTHLY BACKUP C ELSE ~ C OPTION IFEQ 3 ~ C MOVE 'M' WBKPTP ~ C SETON 73 ~ ~ C* SPECIAL BACKUP C ELSE ~ C MOVE 'S' WBKPTP ~ C SETON 74 ~ C END ~OPTION EQ 3 C END ~OPTION EQ 2 C END ~OPTION EQ '1' C KEY SETLLBACKUPF ~ C FINPUT TAG ~ C WRITEINPCMD ~ C EXFMTINPUT ~ C *IN99 CABEQON FMENU ~ C SETOF 8081 ~ ~ C* SEARCH REQUESTED C SEARCH IFNE *BLANK ~ C EXSR SRHSR ~ C GOTO FINPUT ~ C END ~SEARCH NE *BLA ~ C* DELETE REQUESTED C *IN98 IFEQ ON ~DELETE RECORD C KEY CHAINBACKUPF 55 ~ C N55 DELETRBACKUPF ~ C MOVE *BLANKS LIBNAM ~ C MOVE *BLANKS OBJNAM ~ C MOVE *BLANKS SAVCOD ~ C GOTO FINPUT ~ C END ~*IN98 EQ ON ~ C* ROLL UP REQUESTED C *IN97 IFEQ ON ~ROLL UP C EXSR ROLLUP ~ C GOTO FINPUT ~ C END ~*IN97 EQ ON ~ C* ROLL DOWN REQUESTED C *IN96 IFEQ ON ~ROLL DOWN C EXSR ROLLDN ~ C GOTO FINPUT ~ C END ~*IN96 EQ ON C MOVELLIBNAM LIBCHK 1 ~ C MOVELOBJNAM OBJCHK 1 ~ ~ C* LIBRARY SEARCH REQUESTED C LIBCHK IFEQ '*' ~ C SETON 40 ~ C EXSR BLDPF ~ C EXSR SUBFIL ~ C SETOF 9979 ~ C GOTO FINPUT ~ C END ~LIBCHK EQ '*' ~ C* SAVE CODE CHECK ~ C* SKIP SAVE CODE EDIT IF IT IS MONTHLY BACKUP *IN 73 C *IN73 IFEQ OFF ~ C SAVCOD IFNE 'A' ~ C SAVCOD ANDNE'S' ~ C SETON 80 ~ C GOTO FINPUT ~ C END ~SAVCOD NE 'S' C SAVCOD IFEQ 'A' ~ C OBJNAM ANDNE*BLANK ~ C SETON 83 ~ C GOTO FINPUT ~ C END ~SAVCOD NE 'S' C SAVCOD IFEQ 'S' ~ C OBJNAM ANDEQ*BLANK ~ C SETON 81 ~ C GOTO FINPUT ~ C END ~SAVCOD NE 'S' C END ~*IN73 IFEQ OFF ~ C* OBJECT SEARCH REQUESTED C OBJCHK IFEQ '*' ~ C SETOF 40 ~ C LIBNAM IFEQ *BLANKS ~ C SETON 82 ~ C GOTO FINPUT ~ C END ~SAVCOD NE A S C EXSR BLDPF ~ C EXSR OBJSRH ~ C SETOF 99 ~ C GOTO FINPUT ~ C END ~OBJCHK EQ '*' C EXSR UPDADD ~ C GOTO FINPUT ~ C END ~*IN99 DOWEQ OF C EXIT TAG ~ C SETON LR ~ ~ C**************************************************** CSR UPDADD BEGSR ~ ~ C**************************************************** ~ C** DEFAULT MONTHLY SAVCODE WITH "A" CSR 73 MOVE 'A' SAVCOD ~ CSR MOVE LIBNAM WLIB 10 ~ CSR MOVE OBJNAM WOBJ 10 ~ CSR MOVE SAVCOD WSAV 1 ~ CSR KEY CHAINBACKUPF 46 ~ CSR MOVE WLIB LIBNAM ~ CSR MOVE WOBJ OBJNAM ~ CSR MOVE WBKPTP BKPTYP ~ CSR MOVE WSAV SAVCOD ~ ~ C** CSR 46 WRITERBACKUPF ~ CSRN46 UPDATRBACKUPF ~ ~ C**************************************************** CSR ENDSR ~ ~ C**************************************************** ~ C**************************************************** CSR SRHSR BEGSR ~ ~ C**************************************************** CSR MOVE SEARCH LIBNAM ~ CSR KEY SETLLBACKUPF ~ CSR READ BACKUPF 20~20 = EOF CSR *IN20 IFEQ ON ~ CSR BKPTYP ORNE WBKPTP ~ CSR MOVE *BLANKS LIBNAM ~ CSR MOVE *BLANKS OBJNAM ~ CSR MOVE *BLANKS SAVCOD ~ CSR END ~SEARCH EQ *BLA ~ C**************************************************** CSR ENDSR ~ ~ C**************************************************** ~ C**************************************************** CSR ROLLUP BEGSR ~ ~ C**************************************************** CSR READ BACKUPF 20~20 = EOF CSR *IN20 IFEQ ON ~ CSR BKPTYP ORNE WBKPTP ~ CSR MOVE *BLANKS LIBNAM ~ CSR MOVE *BLANKS OBJNAM ~ CSR MOVE *BLANKS SAVCOD ~ CSR END ~*IN20 EQ ONF CSR 20 WBKPTP SETLLBACKUPF ~ ~ C**************************************************** CSR ENDSR ~ ~ C**************************************************** ~ C**************************************************** CSR ROLLDN BEGSR ~ ~ C**************************************************** CSR READPBACKUPF 20~20 = EOF CSR *IN20 IFEQ ON ~ CSR BKPTYP ORNE WBKPTP ~ CSR MOVE *BLANKS OBJNAM ~ CSR MOVE *BLANKS SAVCOD ~ CSR END ~*IN20 EQ ONF CSR 20 WBKPTP SETGTBACKUPF ~ ~ C**************************************************** CSR ENDSR ~ ~ C**************************************************** ~ C**************************************************** CSR BLDPF BEGSR ~ ~ C**************************************************** CSR MOVE *BLANKS OBJECT 10 ~ CSR MOVE *BLANKS LIBRAR 10 ~ CSR MOVE *BLANKS TYPE 10 ~ CSR *IN40 IFEQ ON ~ CSR MOVEL'*ALL' OBJECT ~ CSR MOVEL'QSYS' LIBRAR ~ CSR MOVEL'*LIB' TYPE ~ CSR ELSE ~ CSR MOVEL'*ALL' OBJECT ~ CSR MOVELLIBNAM LIBRAR ~ CSR MOVEL'*ALL' TYPE ~ CSR END ~*IN40 EQ ON CSR CALL 'BLDQLFC' ~ CSR PARM OBJECT ~ CSR PARM LIBRAR ~ CSR PARM QLFNAM 21 ~ CSR MOVEAQLFNAM CMD,9 ~ CSR MOVEATYPE CMD,31 ~ CSR Z-ADD80 LENGTH 155 ~ CSR CALL 'QCAEXEC' ~ CSR PARM CMD ~ CSR PARM LENGTH ~ CSR Z-ADD50 LENGTH 155 ~ CSR CALL 'QCAEXEC' ~ CSR PARM OVR ~ CSR PARM LENGTH ~ ~ C**************************************************** CSR ENDSR ~ ~ C**************************************************** ~ C**************************************************** CSR SUBFIL BEGSR ~ ~ C**************************************************** CSR SETOF 51 ~ CSR Z-ADD0 LRRN 50 ~ CSR WRITELIBCTL ~ CSR SETON 51 ~ CSR OPEN DSPOBJD ~ CSR SETOF 4245 ~ CSR *IN42 DOWEQOFF ~ CSR Z-ADD0 S 10 ~ CSR MOVE *BLANKS LIB ~ CSR MOVE *BLANKS OPT ~ CSR S DOWLE5 ~ CSR READ DSPOBJD 42~ ~ C** SKIP ALL LIBRARIES START WITH Q CSR 40N42 MOVELODOBNM SYSLIB 1 ~ CSR *IN42 IFEQ OFF ~ CSR SYSLIB ANDNE'Q' ~ CSR ADD 1 S ~ CSR MOVELODOBNM LIB,S ~ CSR MOVELODOBNM LIBNAM ~ ~ C** DOES LIBRARY ALREADY EXIST CSR KEY SETLLBACKUPF ~ CSR READ BACKUPF 46~ CSR BKPTYP IFEQ WBKPTP ~ CSR LIBNAM ANDEQODOBNM ~ CSR *IN46 ANDEQOFF ~ CSR MOVE 'X' OPT,S ~ CSR ELSE ~ CSR MOVE ' ' OPT,S ~ CSR END ~BKPTYP IFEQ WB ~ C** CSR END ~*IN42 IFEQ OFF CSRN42 END ~S DOWLE 5 CSR S IFGT 0 ~ CSR ADD 1 LRRN ~ CSR WRITELIBSFL ~ CSR END ~S IFGT 0 CSRN42 END ~*IN42 DOWEQ OF CSR MOVE *BLANKS LIBNAM ~ CSR MOVE *BLANKS OBJNAM ~ CSR MOVE *BLANKS SAVCOD ~ CSR CLOSEDSPOBJD ~ CSR WRITEINPUT ~ CSR WRITECMDKEY ~ CSR EXFMTLIBCTL ~ CSR *IN99 CABEQON ENDSFL ~ CSR MOVEA'000000' *IN,81 ~ CSR *IN45 DOWEQOFF ~ CSR READCLIBSFL 45~ CSR *IN45 IFEQ OFF ~ CSR Z-ADD0 S 10 ~ CSR S DOWLE5 ~ CSR ADD 1 S ~ CSR OPT,S IFEQ 'X' ~ CSR LRRN CHAINLIBSFL 81 ~ ~ C** HIGHLIGHT AND REVERSE CURRENT LIBRARY NAME CSR S COMP 1 81~ CSR S COMP 2 82~ CSR S COMP 3 83~ CSR S COMP 4 84~ CSR S COMP 5 85~ CSR S COMP 6 86~ CSR UPDATLIBSFL ~ ~ C** CSR MOVEA'000000' *IN,81 ~ CSR WRITECMDKEY ~ CSR WRITELIBCTL ~ ~ C** EXECUTE FOLLOWING COMMANDS ONLY IF BACKUP TYPE NOT MONTHLY CSR *IN73 IFEQ OFF ~ CSR SINPUT TAG ~ CSR SETON 79 ~ CSR MOVEALIB,S LIBNAM ~ CSR MOVE 'A' SAVCOD ~ CSR MOVE *BLANKS OBJNAM ~ ~ C** RETRIVE PREVIOUS SAVE CODE CSR KEY SETLLBACKUPF ~ CSR READ BACKUPF 46~ CSR BKPTYP IFNE WBKPTP ~ CSR LIBNAM ORNE LIB,S ~ CSR *IN46 OREQ ON ~ CSR MOVE ' ' SAVCOD ~ CSR MOVE *BLANKS OBJNAM ~ CSR MOVE *BLANKS LIBNAM ~ CSR END ~BKPTYP IFNE WB ~ C** CSR MOVEALIB,S LIBNAM ~ CSR EXFMTINPUT ~ CSR MOVEA'0000' *IN,80 ~ CSR *IN99 CABEQON ENDSFL ~ CSR MOVELLIBNAM LIBCHK ~ CSR MOVELOBJNAM OBJCHK ~ CSR SAVCOD IFNE 'A' ~ CSR SAVCOD ANDNE'S' ~ CSR SETON 80 ~ CSR GOTO SINPUT ~ CSR END ~SAVCOD NE 'S' CSR SAVCOD IFEQ 'A' ~ CSR OBJNAM ANDNE*BLANK ~ CSR SETON 83 ~ CSR GOTO SINPUT ~ CSR END ~SAVCOD NE 'S' CSR SAVCOD IFEQ 'S' ~ CSR OBJNAM ANDEQ*BLANK ~ CSR SETON 81 ~ CSR GOTO SINPUT ~ CSR END ~SAVCOD NE 'S' ~ C* OBJECT SEARCH REQUESTED CSR OBJCHK IFEQ '*' ~ CSR SETOF 40 ~ CSR Z-ADDS SAVES 10 ~ CSR EXSR BLDPF ~ CSR EXSR OBJSRH ~ CSR Z-ADDSAVES S ~ CSR 99 GOTO SINPUT ~ CSR ELSE ~ CSR MOVE WBKPTP BKPTYP ~ CSR EXSR UPDADD ~ CSR END ~OBJCHK EQ '*' CSR ELSE ~ CSR MOVE LIB,S LIBNAM ~ CSR MOVE *BLANKS OBJNAM ~ CSR EXSR UPDADD ~ CSR END ~*IN73 IFEQ OFF CSR END ~OPT,S IFEQ 'X' CSR END ~S DOWLE 5 ~ C** RESET DSPLAY ATTRIBUTES CSR MOVEA'000000' *IN,81 ~ CSR LRRN CHAINLIBSFL 81 ~ CSR UPDATLIBSFL ~ CSR END ~*IN45 IFEQ OFF CSRN45 END ~*IN45 DOWEQ OF ~ C**************************************************** CSR ENDSFL ENDSR ~ ~ C**************************************************** ~ C**************************************************** CSR OBJSRH BEGSR ~ ~ C**************************************************** CSR SETOF 51 ~ CSR Z-ADD0 ORRN 50 ~ CSR WRITEOBJCTL ~ CSR SETON 5184 ~ CSR OPEN DSPOBJD ~ CSR SETOF 4245 ~ CSR *IN42 DOWEQOFF ~ CSR Z-ADD0 S 10 ~ CSR MOVE *BLANKS OBJ ~ CSR MOVE *BLANKS OOPT ~ CSR S DOWLE5 ~ CSR ADD 1 S ~ CSR READ DSPOBJD 42~ CSRN42 MOVELODOBNM OBJ,S ~ CSRN42 MOVELODOBNM OBJNAM ~ CSRN42 KEY CHAINBACKUPF 45 ~ CSRN42N45 MOVE 'X' OOPT,S ~ CSR END ~S DOWLE 5 CSR ADD 1 ORRN ~ CSR WRITEOBJSFL ~ CSRN42 END ~*IN42 DOWEQ OF CSR CLOSEDSPOBJD ~ CSR SETOF 45 ~ CSR WRITECMDKEY ~ CSR EXFMTOBJCTL ~ CSR *IN99 CABEQON ENDOBJ ~ CSR *IN45 DOWEQOFF ~ CSR READCOBJSFL 45~ CSR *IN45 IFEQ OFF ~ CSR Z-ADD0 S 10 ~ CSR S DOWLE5 ~ CSR ADD 1 S ~ CSR OOPT,S IFEQ 'X' ~ CSR MOVEAOBJ,S OBJNAM ~ CSR MOVE WBKPTP BKPTYP ~ CSR EXSR UPDADD ~ CSR END ~OPT,S IFEQ 'X' CSR END ~S DOWLE 5 CSR END ~*IN45 IFEQ OFF CSR END ~*IN45 DOWEQ OF ~ C**************************************************** CSR ENDOBJ ENDSR ~ ~ C**************************************************** ** DISPLAY OBJECT DISCRIPTION TO FILE **** DSPOBJD 9XXXXXXXXX.XXXXXXXXXX 31XXXXXXXX *FULL *NONE DSPOBJD.QTEMP ** OVRIDE DATA BASE FILE **** OVRDBF DSPOBJD DSPOBJD.QTEMP SECURE(*YES)